home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1997 February / EnigmA AMIGA RUN 15 (1997)(G.R. Edizioni)(IT)[!][issue 1997-02][PLANET CD V].iso / progs / thor / thor_2.4 / thor.lha / rexx / SaveRange.thor < prev    next >
Text File  |  1996-11-11  |  4KB  |  148 lines
  1. /* SaveRange.thor by Troels Walsted Hansen <troels@stud.cs.uit.no>
  2. ** $VER: SaveRange.thor v2.1 (06.01.95)
  3. **
  4. ** Save a specified range of messages to disk.
  5. **
  6. ** History
  7. ** ¯¯¯¯¯¯¯
  8. ** v2.00: 
  9. **  · This version is only for THOR v2.0 or higher.
  10. **  · progressbar
  11. **
  12. ** v2.1:
  13. **  · Added choice of filename format, as requested by Jostein Trondal and
  14. **    Trond Larsen
  15. */
  16.  
  17. options results
  18.  
  19. /* needs THOR and bbsread.library functions */
  20.  
  21. p = ' ' || address() || ' ' || show('P',,)
  22. thorport = pos(' THOR.',p)
  23.  
  24. if thorport > 0 then thorport = word(substr(p,thorport+1),1)
  25. else
  26. do
  27.     say 'No THOR port found!'
  28.     exit 10
  29. end
  30.  
  31. if ~show('p', 'BBSREAD') then
  32. do
  33.     address command
  34.         "run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
  35.         "WaitForPort BBSREAD"
  36. end
  37.  
  38. /* get info on messages */
  39.  
  40. address(bbsread)
  41. GETGLOBALDATA stem GLOBALDATA
  42.  
  43. address(thorport)
  44. GETGLOBALCONFIG stem GLOBALCONFIG
  45. CURRENTBBS stem CURRENT
  46.  
  47. if(CURRENT.CONFNAME = "") then
  48. do
  49.     address(bbsread)
  50.         GETCONFLIST '"'CURRENT.BBSNAME'"' CONFLIST
  51.     if(rc ~= 0) then
  52.     do
  53.         address(thorport)
  54.         REQUESTNOTIFY TEXT '"'BBSREAD.LASTERROR'"' BT '"_Ok"'
  55.         exit 5
  56.     end
  57.  
  58.     address(thorport)
  59.     REQUESTLIST instem CONFLIST title '"Select conf:"' SIZEGADGET
  60.     if(rc ~= 0) then exit
  61.     else CURRENT.CONFNAME = result
  62. end
  63.  
  64. address(bbsread)
  65. GETCONFDATA bbsname '"'CURRENT.BBSNAME'"' confname '"'CURRENT.CONFNAME'"' stem CONFDATA
  66.  
  67. if(CONFDATA.FIRSTMSG < 1 | CONFDATA.LASTMSG < 1) then exit
  68.  
  69. address(thorport)
  70. REQUESTINTEGER MIN '"'CONFDATA.FIRSTMSG'"' MAX '"'CONFDATA.LASTMSG'"' INIT '"'CONFDATA.FIRSTMSG'"' TITLE '"First message in range:"' BT '"_Ok|_Cancel"'
  71. firstmsg = result
  72. if(rc ~= 0 | firstmsg = "RESULT") then exit
  73.  
  74. REQUESTINTEGER MIN '"'firstmsg'"' MAX '"'CONFDATA.LASTMSG'"' INIT '"'CONFDATA.LASTMSG'"' TITLE '"Last message in range:"' BT '"_Ok|_Cancel"'
  75. lastmsg = result
  76. if(rc ~= 0 | lastmsg = "RESULT") then exit
  77.  
  78. REQUESTFILE TITLE '"Select directory for messages:"' ID '"'GLOBALCONFIG.SAVEDIR'"' FP PAT '"~"'
  79. if(rc ~= 0 | result = "") then exit
  80. else dir = result
  81.  
  82. REQUESTNOTIFY TEXT '"Select format for the filenames."' BT '"_Confname.MsgNr|_Subject|Subject._readme"'
  83. if(rc ~= 0) then exit
  84.  
  85. select
  86.     when(result = 0) then format = 'readme'
  87.     when(result = 1) then format = 'confname'
  88.     when(result = 2) then format = 'subject'
  89. end
  90.  
  91. /* if user selected a file instead (silly user) reduce it to dirname */
  92.  
  93. endchar = right(dir,1)
  94.  
  95. if(endchar ~= ":" & endchar ~= "/") then do
  96.     posi = lastpos("/",dir)
  97.     if(posi = 0) then posi = lastpos(":",dir)
  98.     dir = delstr(dir,posi+1)
  99. end
  100.  
  101. /* change the illegal filename characters ":" and "/" into "." */
  102.  
  103. if(pos("/",CURRENT.CONFNAME) ~= 0 | pos(":",CURRENT.CONFNAME) ~= 0) then
  104.     newconfname = translate(CURRENT.CONFNAME,"..","/:")
  105. else newconfname = CURRENT.CONFNAME
  106.  
  107. /* save the messages with a progressbar */
  108.  
  109. OPENPROGRESS TITLE '"' || 'Saving messages from ' || CURRENT.CONFNAME || '"' TOTAL lastmsg-firstmsg+1 AT '"_Abort"'
  110. if(rc = 0) then
  111. do
  112.     window = result
  113.  
  114.     do i=firstmsg to lastmsg
  115.         UPDATEPROGRESS REQ window CURRENT i-firstmsg+1 PT '"' || 'Saving message #' || i || '"'
  116.         if(rc ~= 0) then
  117.         do
  118.             CLOSEPROGRESS REQ window
  119.             exit
  120.         end
  121.  
  122.         select
  123.             when(format = 'readme') then
  124.             do
  125.                 address(bbsread)
  126.                 READBRMESSAGE BBSNAME '"'CURRENT.BBSNAME'"' '"'CURRENT.CONFNAME'"' MSGNR '"'i'"' HEADSTEM head
  127.                 filename = substr(translate(HEAD.SUBJECT, '___', ' /:'), 1, pos('.', HEAD.SUBJECT)) || 'readme'
  128.                 address(thorport)
  129.             end
  130.  
  131.             when(format = 'confname') then filename = newconfname || '.' || i
  132.  
  133.             when(format = 'subject') then
  134.             do
  135.                 address(bbsread)
  136.                 READBRMESSAGE BBSNAME '"'CURRENT.BBSNAME'"' '"'CURRENT.CONFNAME'"' MSGNR '"'i'"' HEADSTEM head
  137.                 filename = translate(HEAD.SUBJECT, '___', ' /:')
  138.                 address(thorport)
  139.             end
  140.         end
  141.  
  142.         SAVEMESSAGE BBS '"'CURRENT.BBSNAME'"' CONF '"'CURRENT.CONFNAME'"' MSGNR '"'i'"' FILE '"' || dir || filename || '"'
  143.     end
  144. end
  145. CLOSEPROGRESS REQ window
  146.  
  147. exit
  148.